home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 4 / Amiga Tools 4.iso / grafix / tools / playfkiss / src / iff2cel.e < prev    next >
Text File  |  1996-02-26  |  7KB  |  280 lines
  1. OPT PREPROCESS
  2.  
  3. MODULE    'exec/nodes','exec/lists','exec/ports','exec/types','exec/memory','exec/tasks'
  4. MODULE    'dos/dos','dos/dosextens','dos/notify','dos/dosextens','dos/dosasl'
  5. MODULE    'intuition/intuition','intuition/screens','intuition/gadgetclass','intuition/imageclass'
  6. MODULE    'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view',
  7.                 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/modeid'
  8. MODULE    'utility','utility/hooks','utility/tagitem'
  9. MODULE    'datatypes','datatypes/datatypes','datatypes/datatypesclass',
  10.                                         'datatypes/pictureclass','datatypes/animationclass'
  11. MODULE    'mathffp'
  12.  
  13. MODULE    'tools/boopsi'
  14.  
  15. MODULE    'mod/bits'
  16. MODULE    'mod/compare'
  17. MODULE    'mod/gadgets'
  18. MODULE    'mod/macros'
  19. MODULE    'mod/pool'
  20. MODULE    'mod/color'
  21. MODULE    'mod/tags'
  22.  
  23. CONST FILE_MARK_CELL=$20,FILE_MARK_PALET=$10
  24. RAISE "^C" IF CtrlC()=TRUE
  25.  
  26. DEF errorstring[1000]:STRING    -> A dos error string buffer
  27. DEF str[1000]:STRING                    -> A general string storage
  28. DEF namestr[300]:STRING
  29. DEF task:PTR TO process
  30.  
  31. PROC main() HANDLE
  32.     DEF dtf=NIL:PTR TO dtframebox
  33.     DEF fri=NIL:PTR TO frameinfo
  34.     DEF obj=NIL:PTR TO datatypeheader
  35.     DEF gpl=NIL:PTR TO gplayout
  36.     DEF adtframe:PTR TO adtframe
  37.     DEF dtrast=NIL:PTR TO rastport
  38.     DEF cregs
  39.     DEF bm=NIL:PTR TO bitmap
  40.     DEF bmhd=NIL:PTR TO bitmapheader
  41.     DEF dynatags:PTR TO LONG
  42.  
  43.     DEF    dtn=0:PTR TO datatype
  44.     DEF    dth=0:PTR TO datatypeheader
  45.  
  46.     DEF w,h,d,nof
  47.     DEF i
  48.     DEF lock=0
  49.  
  50.     DEF source:PTR TO LONG                -> Source file(s)/pattern(s)
  51.     DEF rdarg=0
  52.     DEF args[20]:LIST
  53.     DEF name[500]:STRING
  54.     DEF tstr[500]:STRING
  55.  
  56.     NEW dtrast;InitRastPort(dtrast)
  57.  
  58.     IF (utilitybase:=OpenLibrary('utility.library',37))=0 THEN Raise("UTIL")
  59.     IF (datatypesbase:=OpenLibrary('datatypes.library',40))=0 THEN Raise("DTL")
  60.  
  61.     task:=FindTask(0)
  62.     GetProgramName(namestr,490)    -> Get our process name, from the CLI handle.
  63.     IF StrLen(namestr)=0 THEN StrCopy(namestr,task.task.ln.name)    -> Task name, in case above failed
  64.  
  65.     FOR i:=0 TO 19;args[i]:=0;ENDFOR
  66.     rdarg:=ReadArgs('FILES/A/M',args,0)
  67.     IF rdarg=0 THEN Raise("DOS")
  68.     source:=args[0]
  69.     IF source=0 THEN Raise("DOS")
  70.  
  71.     WHILE (source[0])
  72.         CtrlC()
  73.         StrCopy(name,source[]++)
  74.  
  75.         lock:=Lock(name,ACCESS_READ)
  76.         IF lock
  77.             dtn:=ObtainDataTypeA(DTST_FILE,lock,0)
  78.             IF dtn
  79.                 dth:=dtn.header
  80.                 IF dth.groupid=GID_PICTURE
  81.                     obj:=NewDTObjectA(name,[DTA_SOURCETYPE,DTST_FILE,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL])
  82.                     IF obj
  83.                         NEW fri
  84.                         dtf:=NEW [DTM_FRAMEBOX,0,fri,fri,SIZEOF frameinfo,0]:dtframebox
  85.                         IF (domethod(obj,dtf))
  86.                             gpl:=NEW [DTM_PROCLAYOUT,0,1]:gplayout
  87.                             IF (domethod(obj,gpl))
  88.                                 GetDTAttrsA(obj,dynatags:=NEW [
  89.                                     PDTA_BITMAPHEADER,{bmhd},
  90.                                     PDTA_BITMAP,{bm}]);END dynatags
  91.                                 WriteF('  ILBM: (\dx\dx\d)\n',bmhd.width,bmhd.height,bmhd.depth)
  92.                                 StringF(tstr,'\s.CEL',name)
  93.                                 UpperStr(tstr)
  94.                                 WriteF('Saving: "\s"\n',tstr)
  95.                                 convertbitmap(tstr,bm,bmhd.width,bmhd.height)
  96.                             ENDIF
  97.                         ENDIF
  98.                         END dtf
  99.                         END fri
  100.                         DisposeDTObject(obj)
  101.                     ENDIF
  102.                 ENDIF
  103.                 IF dth.groupid=GID_ANIMATION
  104.                     obj:=NewDTObjectA(name,[DTA_SOURCETYPE,DTST_FILE,DTA_GROUPID,GID_ANIMATION,ADTA_REMAP,FALSE,NIL,NIL])
  105.                     IF obj
  106.                         NEW fri
  107.                         dtf:=NEW [DTM_FRAMEBOX,0,fri,fri,SIZEOF frameinfo,0]:dtframebox
  108.                         IF (domethod(obj,dtf))
  109.                             gpl:=NEW [DTM_PROCLAYOUT,0,1]:gplayout
  110.                             IF (domethod(obj,gpl))
  111.                                 GetDTAttrsA(obj,dynatags:=NEW [
  112.                                     ADTA_KEYFRAME,{bm},
  113.                                     ADTA_WIDTH,{w},
  114.                                     ADTA_HEIGHT,{h},
  115.                                     ADTA_DEPTH,{d},
  116.                                     ADTA_FRAMES,{nof}]);END dynatags
  117.                                 WriteF('  ANIM: (\dx\dx\d) \d frames.\n',w,h,d,nof)
  118.                                 FOR i:=0 TO nof-1
  119.                                     adtframe:=NEW [ADTM_LOADFRAME,0,i,0,0,0,0,0,0,0]:adtframe
  120.                                     domethod(obj,adtframe)
  121.                                     StringF(tstr,'\s\z\d[2].CEL',name,i)
  122.                                     UpperStr(tstr)
  123.                                     WriteF('Saving: "\s"\n',tstr)
  124.                                     convertbitmap(tstr,adtframe.bitmap,w,h)
  125.                                     adtframe.methodid:=ADTM_UNLOADFRAME
  126.                                     domethod(obj,adtframe)
  127.                                     END adtframe
  128.                                 ENDFOR
  129.                             ENDIF
  130.                         ENDIF
  131.                         END dtf
  132.                         END fri
  133.                         DisposeDTObject(obj)
  134.                     ENDIF
  135.                 ENDIF
  136.                 ReleaseDataType(dtn)
  137.             ENDIF
  138.         ELSE
  139.             Raise("DOS")
  140.         ENDIF
  141.     ENDWHILE
  142. EXCEPT DO
  143.     IF lock THEN UnLock(lock)
  144.     IF rdarg THEN FreeArgs(rdarg)
  145.     SELECT exception
  146.     CASE 0;NOP
  147.     CASE "MEM";err('out of memory')
  148.     CASE "^C";err('***Break')
  149.     CASE "DTL";err('cannot open datatypes.library v40')
  150.     CASE "UTIL";err('cannot open datatypes.library v40')
  151.     CASE "DOS"
  152.         StrAdd(str,namestr)
  153.         Fault(IoErr(),str,errorstring,998)
  154.         err(errorstring)
  155.     DEFAULT
  156.         StrAdd(str,namestr)
  157.         Fault(exception,str,errorstring,998)
  158.         err(errorstring)
  159.     ENDSELECT
  160. ENDPROC
  161.  
  162. PROC err(msgptr)
  163.     WriteF('\s\n',msgptr)
  164. ENDPROC
  165.  
  166. PROC convertbitmap(str,bitmap:PTR TO bitmap,srcw,srch) HANDLE
  167.     DEF filename[1500]:STRING
  168.     DEF buffer=0:PTR TO CHAR
  169.     DEF fh=0
  170.     DEF ow=0,oh=0,ox=0,oy=0,bits
  171.     DEF gfx=0:PTR TO CHAR
  172.     DEF x=0,y=0
  173.     DEF x1=500000,y1=500000,x2=0,y2=0
  174.     DEF i,t,z,pp
  175.     DEF origsize=0,newsize=0,savesize=0
  176.     DEF xsize,ysize,xoff,yoff
  177.     DEF rp:PTR TO rastport
  178.     DEF leftedge=0
  179.  
  180.     NEW rp;InitRastPort(rp)
  181.     rp.bitmap:=bitmap
  182.  
  183.     IF ((srcw/2)<>((srcw+1)/2))
  184.         srcw:=srcw+1
  185.         leftedge:=TRUE
  186.     ENDIF
  187.     gfx:=New((srcw*srch)+(srcw*2))
  188.     FOR t:=0 TO srch-1
  189.         FOR i:=0 TO srcw-1
  190.             gfx[i+(t*srcw)]:=ReadPixel(rp,i,t)
  191.             IF leftedge
  192.                 IF (i=(srcw-1))
  193.                     gfx[i+(t*srcw)]:=0
  194.                 ENDIF
  195.             ENDIF                    
  196.         ENDFOR
  197.     ENDFOR
  198.     IF bitmap.depth<=4 THEN bits:=4
  199.     IF bitmap.depth>4 THEN bits:=8
  200.     ow:=srcw;oh:=srch
  201.     ox:=0;oy:=0
  202.     IF ((ow>0) AND (oh>0))
  203.         FOR t:=0 TO (oy+oh-1)
  204.             FOR i:=0 TO (ox+ow-1)
  205.                 IF (gfx[i+(t*(ox+ow))])
  206.                     IF (i<x1) THEN x1:=i
  207.                     IF (t<y1) THEN y1:=t
  208.                     IF (i>x2) THEN x2:=i
  209.                     IF (t>y2) THEN y2:=t
  210.                 ENDIF
  211.             ENDFOR
  212.         ENDFOR
  213.         IF ((x1<40000) AND (y1<40000))
  214.             StrCopy(filename,str,ALL)
  215.             StrAdd(filename,'.bak')
  216.             DeleteFile(filename)
  217.             Rename(str,filename)
  218.             fh:=Open(str,MODE_NEWFILE)
  219.             IF (fh)
  220.                 xsize:=x2-x1+1
  221.                 IF ((xsize/2)<>((xsize+1)/2))
  222.                     xsize:=xsize+1
  223.                 ENDIF
  224.                 buffer:=New(((xsize)*2)+xsize)
  225.                 ysize:=y2-y1+1
  226.                 xoff:=x1
  227.                 yoff:=y1
  228.                 PutLong(buffer,"KiSS")
  229.                 buffer[4]:=FILE_MARK_CELL
  230.                 buffer[5]:=bits
  231.  
  232.                 PutInt(buffer+8, ibmconv(xsize))
  233.                 PutInt(buffer+10,ibmconv(ysize))
  234.                 PutInt(buffer+12,ibmconv(xoff))
  235.                 PutInt(buffer+14,ibmconv(yoff))
  236.  
  237.                 Write(fh,buffer,32)
  238.  
  239.                 IF (bits=8)
  240.                     FOR t:=yoff TO (yoff+ysize-1)
  241.                         z:=0
  242.                         pp:=t*(ox+ow)
  243.                         FOR i:=xoff TO (xoff+xsize-1)
  244.                             buffer[z]:=gfx[pp+i]
  245.                             z:=z+1
  246.                         ENDFOR
  247.                         Write(fh,buffer,xsize)
  248.                     ENDFOR
  249.                 ELSE
  250.                     FOR t:=yoff TO (yoff+ysize-1)
  251.                         z:=0
  252.                         pp:=(t*(ox+ow))+xoff
  253.                         FOR i:=0 TO (xsize-1) STEP 2
  254.                             buffer[z]:=(((gfx[pp] AND $F)*$10) OR ((gfx[pp+1] AND $F)))
  255.                             pp:=pp+2
  256.                             z:=z+1
  257.                         ENDFOR
  258.                         Write(fh,buffer,z)
  259.                     ENDFOR
  260.                 ENDIF
  261.             ELSE
  262.                 Raise("DOS")
  263.             ENDIF
  264.         ENDIF
  265.     ENDIF
  266.  
  267. EXCEPT DO
  268.     IF (fh) THEN Close(fh)
  269.     IF (buffer) THEN Dispose(buffer)
  270.     IF (gfx) THEN Dispose(gfx)
  271.     IF exception THEN ReThrow()
  272. ENDPROC
  273.  
  274. PROC ibmconv(a)
  275.     DEF hi,lo,ret
  276.     hi:=a AND $FF00
  277.     lo:=a AND $00FF
  278.     ret:=Shl(lo,8) OR Shr(hi,8)
  279. ENDPROC ret
  280.